home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d18
/
gsdb21.arc
/
GS_DBASE.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-01-04
|
49KB
|
1,023 lines
{ dBase III File Handler
GS_DBASE Copyright (c) Richard F. Griffin
15 November 1990
102 Molded Stone Pl
Warner Robins, GA 31088
-------------------------------------------------------------
This unit handles the objects for all dBase III file (.DBF)
operations.
SHAREWARE -- COMMERCIAL USE RESTRICTED
Changes:
16 Nov 90 - Moved Pack method to GS_dBFld.
}
{
┌──────────────────────┐
│ INTERFACE SECTION: │
└──────────────────────┘
}
unit GS_DBASE;
interface
uses
CRT,
DOS,
GS_KeyI,
GS_FileH, {File handler}
GS_Strng, {String handling Routines}
GS_Error, {Error Handling routines}
GS_DBNdx; {Unit for index operations (.NDX files)}
const
GS_dBase_MaxRecBytes = 4000; {dBASE III record limit }
GS_dBase_MaxRecField = 128; {dBASE III field limit}
GS_dBase_MaxMemoRec = 512; {Size of each block of memo file data}
Next_Record = -1; {Token value passed to read next record}
Prev_Record = -2; {Token value passed to read previous record}
Top_Record = -3; {Token value passed to read first record}
Bttm_Record = -4; {Token value passed to read final record}
GS_dBase_UnDltChr = 32; {Character for Undeleted Record}
GS_dBase_DltChr = 42; {Character for Deleted Record}
type
GS_dBase_Status = (NotOpen, NotUpdated, Updated);
{Flags to indicate status of dBase III file }
GS_dBase_dRec = ^GS_dBase_DataRecord;
{Pointer type used in object descriptions to locate the memory}
{array in bytes for the dBase record. Uses GS_dBase_DataRecord}
{defined below.}
GS_dBase_DataRecord = ARRAY[0..GS_dBase_MaxRecBytes] OF Byte;
{Defines an array of bytes in memory that is as large as the }
{maximum size of a dBase record (GS_dBase_MaxRecBytes).}
{
┌──────────────────────────────────────────────────────────────────┐
│ ******** Data Structure Description ********** │
│ │
│ The following record defines the dBase III file header. Refer │
│ to Appendix A for an explanation of each data element. │
└──────────────────────────────────────────────────────────────────┘
}
GS_dBase_Head = Record
DBType : Byte;
Year : Byte;
Month : Byte;
Day : Byte;
RecCount : LongInt;
Location : Integer;
RecordLen : Integer;
Reserved : Array[1..20] of Byte;
end;
{
┌──────────────────────────────────────────────────────────────────┐
│ ********* Field Descriptor ********* │
│ │
│ This record defines the field descriptor. There is one of │
│ these for each field defined in the database structure. They │
│ are stacked as 32 bytes following the file header record, as │
│ described in Appendix A. │
└──────────────────────────────────────────────────────────────────┘
}
GS_dBase_Field = Record
FieldName : String[10];
{Array[1..11] of Char actually}
{This is to simplify conversion}
FieldType : Char;
FieldAddress : LongInt;
FieldLen : Byte;
FieldDec : Byte;
Reserved : Array[1..14] of Char;
end;
GS_dBase_dFld = ^GS_dBase_DataField;
{Pointer type used in object descriptions to assign memory}
{for storing the field descriptors. }
GS_dBase_DataField = ARRAY[1..GS_dBase_MaxRecField] OF GS_dBase_Field;
{Defines an array of field descriptors (GS_dBase_Field) that}
{is as large as the maximum number of dBase fields allowed}
{(GS_dBase_MaxRecFields).}
GS_dBase_nFld = ^GS_dBase_NameField;
{Pointer type used in object descriptions to assign memory}
{for storing the field name strings. }
GS_dBase_NameField = Array[1..GS_dBase_MaxRecField] OF string[11];
{Defines an array of field name strings (GS_dBase_Field) that}
{is as large as the maximum number of dBase fields allowed}
{(GS_dBase_MaxRecFields).}
{
┌──────────────────────────────────────────────────────────────┐
│ *********** dBase Object Definition ************ │
└──────────────────────────────────────────────────────────────┘
}
GS_dBase_DB = object(GS_KeyI_Objt) {Make it a child for keyboard control}
FileName : string[64]; {Stores FileName of dBase File}
dFile : file; {File Type to reference data file}
mFile : file; {File Type to reference memo file}
HeadProlog : GS_dBase_Head; {Image of file header}
dStatus : GS_dBase_Status; {Holds Status Code of file}
WithMemo : Boolean; {True if memo file present}
DateOfUpdate : string[8]; {MM/DD/YY of last update}
NumRecs : LongInt; {Number of records in file}
HeadLen : Integer; {Header + Field Descriptor length}
RecLen : Integer; {Length of record}
NumFields : Integer; {Number of fields in the record}
Fields : GS_dBase_dFld; {Pointer to memory array holding}
{field descriptors}
FieldsN : GS_dBase_nFld; {Pointer to memory array holding}
{Field name strings}
RecNumber : LongInt; {Physical record number last read}
CurRecord : GS_dBase_dRec; {Pointer to memory array holding}
{the current record data. Refer}
{to Appendix B for record structure}
DelFlag : boolean; {True if record deleted}
File_EOF : boolean; {True if at end of file }
Found : boolean; {Set True on valid record Find}
dbfNdxTbl : array [1..16] of GS_Indx_LPtr;
{Holds addresses of up to 16 Index}
{Objects. The first array is the}
{Master Index. For File changes,}
{this array will be used to ensure}
{all indexes are updated. }
dbfNdxActv : boolean; {True if an index file is used}
{
┌───────────────────────────────────────────────────────────────────────┐
│ *** These methods are described individually in the following *** │
│ pages. As seen here, their name describes their function │
└───────────────────────────────────────────────────────────────────────┘
}
PROCEDURE Append;
PROCEDURE Blank;
PROCEDURE Close;
FUNCTION Create(FName : string) : boolean;
PROCEDURE Delete;
FUNCTION Find(st : string) : boolean;
FUNCTION Formula(st : string) : string; virtual;
PROCEDURE GetRec(RecNum: LongInt);
PROCEDURE Index(IName : String);
PROCEDURE Index_List(RecAct: LongInt; var I_List; var RNum : longint);
CONSTRUCTOR Init(FName : string);
PROCEDURE Open;
PROCEDURE PutRec(RecNum : LongInt);
PROCEDURE UnDelete;
end;
{
┌──────────────────────────┐
│ IMPLEMENTATION SECTION │
└──────────────────────────┘
}
implementation
uses
GS_dB3Wk; {Use shown here to avoid circular def.}
CONST
DB3File = 3; {First byte of dBase III(+) file}
DB3WithMemo = $83; {First byte of dBase III(+) file}
{if memo file (.DBT) is present }
PROCEDURE GS_dBase_DB.Append;
BEGIN
PutRec(0);
{Calls objectname.PutRec method with a record number of}
{zero. This causes the record number to default to }
{objectname.NumRecs + 1. }
END;
PROCEDURE GS_dBase_DB.Blank;
begin
FillChar(CurRecord^[0], RecLen, ' ');
{Fill spaces for RecLen bytes}
end;
PROCEDURE GS_dBase_DB.Close;
CONST
EofMark : Byte = $1A; {ASCII code for EOF byte}
var
rsl,
yy, mm, dd, wd : word; {Local variables to get today's}
{date through TP's GetDate procedure}
i : integer; {work variable}
{
┌──────────────────────────────────────────────────────────────┐
│ The Update_File procedure is called if any records are │
│ added/updated while the file is open. This is indicated │
│ by objectname.dStatus set to 'UpDated'. The procedure │
│ inserts the current date in the file header, updates the │
│ record count, rewrites the file header, and writes an EOF │
│ byte at the end of the file. │
└──────────────────────────────────────────────────────────────┘
}
procedure UpDate_File;
BEGIN
GetDate (yy,mm,dd,wd); {Call TP's GetDate procedure}
HeadProlog.year := yy-1900; {Extract the Year}
HeadProlog.month := mm; {Extract the Month}
HeadProlog.day := dd; {Extract the Day}
HeadProlog.RecCount := NumRecs; {Update number records in file}
GS_FileWrite(dFile, 0, HeadProlog, 8, rsl);
GS_FileWrite(dFile, HeadLen+NumRecs*RecLen, EofMark, 1, rsl); {EOF marker}
END; { IF Updated }
{
┌───────────────────────────────────────────────────────────┐
│ Beginning of CLOSE Procedure. │
│ 1. Exit if file not open │
│ 2. Update the file header if records added/updated │
│ 3. Close the file │
│ 4. Close the .DBT memo file if applicable │
│ 5. Set objectname.dStatus to 'NotOpen' │
└───────────────────────────────────────────────────────────┘
}
begin
IF dStatus = NotOpen THEN exit; {Exit if file not open}
IF dStatus = Updated THEN UpDate_File;
{Write new header information if the}
{file was updated in any way}
GS_FileClose(dFile);
if WithMemo then GS_FileClose(mFile);
{
┌──────────────────────────────────────────────────────────┐
│ The following routine releases index files associated │
│ with the .DBF file and releases memory. │
└──────────────────────────────────────────────────────────┘
}
i := 1; {initialize counter}
while dbfNdxTbl[i] <> nil do
begin
dbfNdxTbl[i]^.Ndx_Close; {Close this index file}
dispose(dbfNdxTbl[i]); {Release Heap Memory}
dbfNdxTbl[i] := nil; {set pointer to 'empty'}
inc(i); {increment counter}
end;
dbfNdxActv := false;
dStatus := NotOpen; {Set objectname.dStatus to 'NotOpen'}
END; { GS_dBase_Close }
Function GS_dBase_DB.Create(FName : string) : boolean;
begin
if GS_dB3_Create(FName) then Create := true else Create := false;
END; { GS_dBase_Create }
PROCEDURE GS_dBase_DB.Delete;
begin
DelFlag := true; {Set Delete Flag to true}
CurRecord^[0] := GS_dBase_DltChr; {Put '*' in first byte of current record}
PutRec(RecNumber); {Write the current record to disk }
end; {GS_dBase_Delete}
{
FIND
╔══════════════════════════════════════════════════════════════════╗
║ ║
║ The FIND method will search the master index file for the ║
║ key string contained in the calling argument. ║
║ ║
║ Note: At this time, numeric fields must have a string value ║
║ argument, and date fields are not handled. ║
║ ║
║ Calling the Method: ║
║ ║
║ objectname.Find(String) ║
║ ║
║ ( where objectname is of type GS_dBase_DB, ║
║ String is key value to match) ║
║ ║
║ Result: ║
║ ║
║ Matching record is read if found. No error check, ║
║ but index object Found flag is set true on match. ║
║ ║
╚══════════════════════════════════════════════════════════════════╝
}
Function GS_dBase_DB.Find(st : string) : boolean;
var
RNum : longint;
begin
{
┌───────────────────────────────────────────────────────────┐
│ The next statement checks to see if an index is active │
│ (dbfNdxActv = true), and calls the index object's │
│ KeyFind method if true. The key string is passed to │
│ the method as the only argument. The matching record │
│ is returned from the method. If there is no match, │
│ the method returns a zero value. Note that the method │
│ is called using the first index object pointer in array │
│ dbfNdxTabl (the master index). The ability to use an │
│ object pointer in place of an actual object is a highly │
│ useful tool. │
└───────────────────────────────────────────────────────────┘
}
if (dbfNdxActv) then
begin
RNum := dbfNdxTbl[1]^.KeyFind(st);
if RNum > 0 then {RNum = 0 if no match, otherwise}
{it holds the valid record number}
begin
GetRec(RNum); {If match found, read the record}
Found := True; {Set Match Found flag true}
end else
begin {If no matching index key, then}
Found := False; {Set Match Found Flag False}
end;
end else {If there is no index file, then}
Found := False; {Set Match Found Flag False}
Find := Found;
end; {GS_dBase_Find}
function GS_dBase_DB.Formula(st : string) : string;
begin
ShowError(399,'Object for field handling missing');
Formula := '';
end;
{
GETREC
╔═══════════════════════════════════════════════════════════════════════╗
║ ║
║ The GETREC method will access the dBase III file to retrieve the ║
║ record number passed in the call. ║
║ ║
║ Calling the Method: ║
║ ║
║ objectname.GetRec (RecNum) ║
║ ║
║ ( where objectname is of type GS_dBase_DB, ║
║ RecNum is the record number to retrieve. ║
║ ** If a number greater than 0, record ║
║ will be physical number from .DBF; ║
║ if Next_Record, Prev_Record, ║
║ Top_Record, or Bttm_Record, then ║
║ the appropriate record will be found. ║
║ For these codes, if an index is in ║
║ use, the record will be retrieved ║
║ based on it's location in the index.) ║
║ ║
║ Result: ║
║ ║
║ 1. Record is retrieved based on record number argument ║
║ 2. Objectname.RecNumber set to record number read ║
║ 3. Objectname.DelFlag set true if deleted record ║
║ 4. If last record of file (.DBF or .NDX), then ║
║ objectname.File_EOF set true. ║
║ ║
╚═══════════════════════════════════════════════════════════════════════╝
}
PROCEDURE GS_dBase_DB.GetRec(RecNum : LongInt);
VAR
dFilea : FileRec absolute dFile;
i,
Result : Integer; {Local working variable}
RNum : LongInt; {Local working variable }
StrFil : String[80];
rsl : word;
BEGIN
if NumRecs = 0 then
begin
File_EOF := true;
exit;
end;
RNum := RecNum; {Store RecNum locally for modification}
File_EOF := false; {Initialize End of File Flag to false}
{
┌───────────────────────────────────────────────────────────┐
│ The next statement checks to see if an index is active │
│ (dbfNdxActv = true), and calls the index object's │
│ KeyRead method if true and the record requested is │
│ a relative record (less than 0). Note that the method │
│ is called using the first index object pointer in array │
│ dbfNdxTabl (the master index). The ability to use an │
│ object pointer in place of an actual object is a highly │
│ useful tool. Upon return, the index file's EOF flag is │
│ stored as the .DBF's End-of-File Flag. │
└───────────────────────────────────────────────────────────┘
}
if (dbfNdxActv) and (RecNum < 0) then
begin
RNum := dbfNdxTbl[1]^.KeyRead(RecNum);
{Get record number of physical}
{record to read from .DBF.}
File_EOF :=dbfNdxTbl[1]^.KeyEOF;
{Get index EOF flag. The EOF will be}
{set when a KeyRead of Next_Record}
{will go past the last index record}
end
else
if (dbfNdxActv) and (RNum > 0) and (RNum <= NumRecs) then
if not dbfNdxTbl[1]^.KeyLocRec(RecNum) then exit;
{If physical record search, set index}
{to the same record.}
if File_EOF then exit; {Return if EOF reached}
{
┌──────────────────────────────────────────────────────────┐
│ The value in RNum is tested to see if it is a relative │
│ record seek or a physical record number. The number │
│ is also tested to ensure it is in the file record │
│ range of valid numbers. Note, if an index was read, │
│ RNum will now be a physical record. │
└──────────────────────────────────────────────────────────┘
}
case RNum of
Next_Record : begin
RNum := RecNumber + 1;
{Get next sequential record}
if RNum > NumRecs then
begin {If beyond number of records in file,}
{you must recover}
RNum := NumRecs;
{Reset to final record}
File_EOF := true;
{Set EOF Flag to True}
exit; {Return from GetRec}
end;
end;
Prev_Record : begin
RNum := RecNumber - 1;
{Get Previous Record}
if RNum < 1 then RNum := 1;
{If at beginning of file, stay}
end;
Top_Record : RNum := 1; {Set to the first record}
Bttm_Record : RNum := NumRecs; {Set to the last record}
end;
if (RNum < 1) or (RNum > NumRecs) then
begin {if a physical record number is out}
{of range, exit with error}
i := 0;
Str(RNum, StrFil);
StrFil := 'Record ' + StrFil;
StrFil := StrFil + ' Out of Range for File ';
while dFilea.Name[i] <> #0 do
begin
StrFil := StrFil + dFilea.Name[i];
inc(i);
end;
ShowError(100,StrFil);
exit; {Terminate read attempt if record number}
{is out of range}
end;
GS_FileRead(dFile, HeadLen+(RNum-1) * RecLen, CurRecord^, RecLen, rsl);
{Read RecLen bytes into memory buffer}
{for the correct physical record}
RecNumber := RNum; {Set objectname.RecNumber = this record }
if CurRecord^[0] = GS_dBase_DltChr then DelFlag := true
else DelFlag := false; {Set objectname.DelFlag to show status}
{of the record's Delete byte}
END; {GetRec}
{
INDEX
╔══════════════════════════════════════════════════════════════════╗
║ ║
║ The INDEX method initializes the index array in objectname ║
║ and assigns the first index as the master index. The other ║
║ index files will be updated upon .DBF updates (when the ║
║ index write entries are added). ║
║ ║
║ Calling the Method: ║
║ ║
║ objectname.Index(String) ║
║ ║
║ ( where objectname is of type GS_dBase_DB, ║
║ String is list of index files, separated ║
║ by spaces. ║
║ ║
║ Result: ║
║ ║
║ Index files are assigned and the master index is ║
║ opened. ║
║ ║
╚══════════════════════════════════════════════════════════════════╝
}
Procedure GS_dBase_DB.Index (IName : String);
var
i,j : integer; {Local working variable }
st : String[64]; {Local working variable}
begin
{
┌───────────────────────────────────────────────────┐
│ Reset index file array. │
│ 1. Close open index files │
│ 2. Release index objects stored on the heap │
│ 3. Set array pointers to nil. │
└───────────────────────────────────────────────────┘
}
i := 1;
while dbfNdxTbl[i] <> nil do
begin
dbfNdxTbl[i]^.Ndx_Close;
Dispose(dbfNdxTbl[i]);
dbfNdxTbl[i] := nil;
inc(i);
end;
dbfNdxActv := false; {Set index active flag to false}
{
┌──────────────────────────────────────────────────────┐
│ This routine scans the input string for the names │
│ of index files. Names must be separated by commas │
│ or spaces. The .NDX extension must not be part │
│ of the file name │
└──────────────────────────────────────────────────────┘
}
i := 0; {i will hold count of index files}
j := 1;
st := '';
while j <= length(IName) do
begin
{
┌───────────────────────────────────────────────┐
│ Build an index file name in st until end of │
│ input string, a comma, or a space is found │
└───────────────────────────────────────────────┘
}
if (IName[j] <> ' ') and (IName[j] <> ',') then
st := st + IName[j]
else
begin {When file string is complete:}
inc(i); {Increment index file count}
if st <> '' then { If not an empty string: }
begin
New(dbfNdxTbl[i]); {Get heap memory for index object}
if dbfNdxTbl[i]^.Init(st) then
begin {Initialize index object}
end;
end;
st := ''; {Reset file name to empty for next}
end;
inc(j); {Inc counter for next input string char }
end;
{
┌─────────────────────────────────────────────────┐
│ This routine is needed to finish out when the │
│ input string is finished. Note the routine │
│ above does not create an index entry at the │
│ end of the input string. That is done here. │
└─────────────────────────────────────────────────┘
}
if st <> '' then
begin
inc(i);
New(dbfNdxTbl[i]);
if dbfNdxTbl[i]^.Init(st) then
begin
end;
end;
if i > 0 then dbfNdxActv := true; {Set index active flag true if index }
{files are found }
end;
{
INDEX_LIST
╔══════════════════════════════════════════════════════════════════╗
║ ║
║ The INDEX_LIST method returns the index key field from the ║
║ index used as the master index. This is done instead of the ║
║ normal action of reading the .DBF file. Only the index file ║
║ is read during this method. A common use of this method is ║
║ to build a memory table of keys and associated record numbers. ║
║ ║
║ Calling the Method: ║
║ ║
║ objectname.Index_LIST(RecNum, String, RNum) ║
║ ║
║ ( where objectname is of type GS_dBase_DB, ║
║ RecAct is the index key to retrieve. ║
║ (Top_Record, Next_Record, ║
║ Prev_Record, or Bttm_Record) ║
║ ║
║ String is field to place key value. ║
║ RNum is field to place record number. ║
║ ║
║ Result: ║
║ ║
║ The master Index file is accessed based on RecAct. ║
║ The value in the key field entry is returned in ║
║ String. The record's location id the .DBF file is ║
║ returned in RecNum. File_EOF is set upon an attempt ║
║ to access beyond the last index entry. ║
║ ║
╚══════════════════════════════════════════════════════════════════╝
}
Procedure GS_dBase_DB.Index_List(RecAct: LongInt; var I_List;
var RNum : longint);
var
I_L : string[255] absolute I_List;
{Redefines I_List for internal use}
BEGIN
{
┌───────────────────────────────────────────────────────────┐
│ The next statement checks to see if an index is active │
│ (dbfNdxActv = true), and calls the index object's │
│ KeyRead method if true and the record requested is │
│ a relative record (less than 0). Note that the method │
│ is called using the first index object pointer in array │
│ dbfNdxTabl (the master index). │
└───────────────────────────────────────────────────────────┘
}
if (dbfNdxActv) and (RecAct < 0) then
begin
RNum := dbfNdxTbl[1]^.KeyRead(RecAct);
if RNum > 0 then {if good read, RNum will be > 0}
begin
I_L := dbfNdxTbl[1]^.Ndx_Key_St;
{get key value, and store in the}
{I_List variable, using I_L which}
{points to the same memory location}
end else
begin
RNum := 0; {set null value if no valid read}
I_L := ''; {set null value if no valid read}
end;
File_EOF := dbfNdxTbl[1]^.KeyEOF;
{move index EOF flag to File_EOF};
end;
end;
{
INIT
╔══════════════════════════════════════════════════════════════════╗
║ ║
║ The INIT method initializes objectname by reading the .DBF ║
║ file and loading file structure information into the object. ║
║ It also checks for a memo file (.DBT) and assigns that to ║
║ a file type if it exists. This routine must be called ║
║ before using the other methods in objectname. ║
║ ║
║ Calling the Method: ║
║ ║
║ objectname.Init(String) ║
║ ║
║ ( where objectname is of type GS_dBase_DB, ║
║ String is the file name of the dBase ║
║ file (without the .DBF extension). ║
║ ║
║ Result: ║
║ ║
║ DBase file object is initialized and memo file is ║
║ initialized. ║
║ ║
╚══════════════════════════════════════════════════════════════════╝
}
CONSTRUCTOR GS_dBase_DB.Init(FName : string);
var
i : integer; {Local working variable}
{
┌───────────────────────────────────────────────────────┐
│ The ProcessHeader Procedure stores information from │
│ the dBase III .DBF file into objectname. │
└───────────────────────────────────────────────────────┘
}
PROCEDURE ProcessHeader;
VAR
dFilea : FileRec absolute dFile;
StrFil : string[80];
WSt : string[12];
Result : word;
ofs : longint;
o, i : Integer; {Local working variables}
m,dy,y : string[2]; {Local working variables}
BEGIN {ProcessHeader}
{
┌─────────────────────────────────────────────────┐
│ Test to ensure file is a dBase III .DBF file. │
│ Exit with error if it is not. Set the │
│ objectname.WithMemo flag if memo file present. │
└─────────────────────────────────────────────────┘
}
CASE HeadProlog.DBType OF
DB3File : WithMemo := False;
DB3WithMemo : WithMemo := True;
ELSE
BEGIN
GS_FileClose(dFile); {If not a valid dBase file, close}
StrFil := '';
i := 0;
while dFilea.Name[i] <> #0 do
begin
StrFil := StrFil + dFilea.Name[i];
inc(i);
end;
StrFil := StrFil + ' not a dBase III file';
ShowError(157,StrFil);
Exit;
END;
END; {CASE}
{
┌─────────────────────────────────────────────┐
│ Convert numeric date fields to ASCII text │
└─────────────────────────────────────────────┘
}
Str(HeadProlog.month,m);
if length(m) = 1 then m := '0'+m;
Str(HeadProlog.day,dy);
if length(dy) = 1 then dy := '0'+dy;
Str(HeadProlog.year,y);
if length(y) = 1 then y := '0'+y;
DateOfUpdate := m + '/' + dy + '/' + y;
NumRecs := HeadProlog.RecCount; {Number of records in file}
HeadLen := HeadProlog.Location; {Starting byte location of first record}
RecLen := HeadProlog.RecordLen; {Length of each record}
RecNumber := 0; {Set current record to zero}
File_EOF := false; {Set End of File flag to false}
GetMem(Fields, HeadLen-33); {Allocate memory for fields buffer.}
{Compute total header size as length of}
{header file information (32 bytes),}
{End of Header mark (1 byte), and the}
{field descriptors (32 bytes each).}
{Size - 33 = memory required by fields}
NumFields := (HeadLen - 33) div 32;
{Each field descriptor is 32 bytes}
{Field descriptor area of header can}
{be divided by 32 to get field count}
GS_FileRead(dFile, -1, Fields^, HeadLen-33, Result);
{Read field descriptor portion of header}
GetMem(FieldsN, NumFields*12); {Allocate memory for fields buffer.}
ofs := 1; {Find offset for each field}
for i := 1 to NumFields do
begin
Fields^[i].FieldAddress := ofs;
ofs := ofs + Fields^[i].FieldLen;
move(Fields^[i].FieldName,WSt[1],11);
WSt[0] := #11;
WSt[0] := char(pred(pos(#0,WSt)));
WSt := TrimR(WSt); {Remove trailing spaces}
FieldsN^[i] := WSt;
end;
END; {ProcessHeader}
{
┌──────────────────────────────────────────────────────────┐
│ The GetHeader Procedure does the initial file read. │
│ Reads the first 32 bytes of .DBF file. This contains │
│ information on record size, field descriptor size, │
│ last date updated. Starting point for all other │
│ file structure information. │
└──────────────────────────────────────────────────────────┘
}
PROCEDURE GetHeader;
VAR
Result : Word;
BEGIN { GetHeader }
GS_FileRead(dFile, 0, HeadProlog, 32, Result);
ProcessHeader;
END; { GetHeader }
{
┌─────────────────────────────────────────────────┐
│ Beginning of INIT Procedure. It does the │
│ following: │
│ 1. Assigns .DBF extension to the file. │
│ 2. Opens the file. │
│ 3. Gets header information for the │
│ objectname object. │
│ 4. Closes file. │
│ 5. Allocates memory for a record buffer │
│ 6. Sets file status to 'Not Open'. │
│ 7. Sets Index Active to false. │
│ 8. If memo file, assigns a file type. │
└─────────────────────────────────────────────────┘
}
begin
Filename := FName+'.DBF'; {Assign .DBF file extension}
GS_FileAssign(dFile, FileName,8192);
GS_FileReset(dFile, 1);
GetHeader; {Load file structure information into}
{objectname}
GS_FileClose(dFile); {Finished with file for now}
GetMem(CurRecord, RecLen); {Allocate memory for record buffer}
dStatus := NotOpen; {Set file status to 'Not Open' }
dbfNdxActv := false; {Set index active flag to false}
for i := 1 to 16 do dbfNdxTbl[i] := nil;
{Set index object pointer array to nil}
if WithMemo then
begin
GS_FileAssign(mFile, FName+'.DBT',2048);
{If a memo file is attached, then assign}
{it to a file type. This must be done}
{here so all future objects can get to}
{the file if necessary.}
end;
GS_KeyI_Objt.Init; {Initialize parent object}
end;
{
OPEN
╔══════════════════════════════════════════════════════════════════╗
║ ║
║ The OPEN method checks to see if the file referenced by ║
║ objectname is already open. If it is open, no other action ║
║ is taken. If the file is not open, then it and its memo ║
║ file, if one exists, is opened and flags are set. ║
║ ║
║ Calling the Method: ║
║ ║
║ objectname.Open ║
║ ║
║ ( where objectname is of type GS_dBase_DB ) ║
║ ║
║ Result: ║
║ ║
║ 1. If file already opened, no action is taken. ║
║ ║
║ otherwise: ║
║ ║
║ 1. .DBF file is opened. ║
║ 2. File status set to 'Not Updated'. ║
║ 3. If memo file exists, .DBT file is opened. ║
║ 4. Current record number is set to zero. ║
║ ║
╚══════════════════════════════════════════════════════════════════╝
}
PROCEDURE GS_dBase_DB.Open;
BEGIN { GS_dBase_Open }
if dStatus = NotOpen then {Do only if file not already open}
begin
GS_FileAssign(dFile, FileName,4096);
GS_FileReset(dFile, 1); {Open .DBF file
dStatus := NotUpdated; {Set status to 'Not Updated' }
if WithMemo then GS_FileReset(mFile,GS_dBase_MaxMemoRec);
{If memo file, then open .DBT file}
RecNumber := 0; {Set current record to zero }
Blank; {Clear the record buffer}
end;
END; { GS_dBase_Open }
{
PUTREC
╔══════════════════════════════════════════════════════════════════╗
║ ║
║ The PUTREC method will write an updated record to the dBase ║
║ III(+) .DBF file. The data to be written must be stored ║
║ in objectname.CurRecord^ prior to calling the method. ║
║ ║
║ Calling the Method: ║
║ ║
║ objectname.PutRec(RecNum) ║
║ ║
║ ( where objectname is of type GS_dBase_DB, ║
║ RecNum is physical record number to ║
║ write to. If not within the range of ║
║ existing records, it record will be ║
║ appended to the end of the file. ║
║ ║
║ Result: ║
║ ║
║ 1. If RecNum not in range of existing records ║
║ it will be appended and objectname.NumRecs ║
║ incremented by one. ║
║ 2. Record will be written. ║
║ 3. RecNum will become current record number. ║
║ 4. File status will be changed to 'Updated'. ║
║ ║
╚══════════════════════════════════════════════════════════════════╝
}
PROCEDURE GS_dBase_DB.PutRec(RecNum : LongInt);
VAR
Result : Word; {Local Variable}
RNum : LongInt; {Local Variable}
IKey : String; {Local Variable for Key Formula string}
BEGIN
RNum := RecNum; {Move RecNum to local variable for }
{possible modification}
{
┌─────────────────────────────────────────────┐
│ If Record Number not in range of existing │
│ records, append it to the end of file. │
└─────────────────────────────────────────────┘
}
IF (RNum > NumRecs) or (RNum < 1) then
begin
inc(NumRecs); {Increment record count}
RNum := NumRecs; {Put last record number in RNum}
end;
GS_FileWrite(dFile, HeadLen+(RNum-1)*RecLen, CurRecord^, RecLen, Result);
RecNumber := RNum; {Store record number as current record }
dStatus := Updated; {Set file status to 'Updated'}
{
┌───────────────────────────────────────────────────────────┐
│ The next statement checks to see if an index is active │
│ (dbfNdxActv = true), and calls the index object's │
│ KeyUpdate method if true. Note that the method │
│ is called using the first index object pointer in array │
│ dbfNdxTabl (the master index). │
└───────────────────────────────────────────────────────────┘
}
if (dbfNdxActv) then
begin
dbfNdxTbl[1]^.KeyUpdate(Formula(dbfNdxTbl[1]^.Ndx_Key_Form),RNum,RecNum);
end;
END; {PutRec}
{.pa}
{
UNDELETE
╔═══════════════════════════════════════════════════════════════════════╗
║ ║
║ The UNDELETE method will reset the Delete flag in the dBase III(+) ║
║ file. ║
║ ║
║ Calling the Method: ║
║ ║
║ objectname.UnDelete ║
║ ║
║ ( where objectname is of type GS_dBase_DB) ║
║ ║
║ Result: ║
║ ║
║ 1. objectname.DelFlag is set false. ║
║ 2. A ' ' (UnDelete flag) is set in byte 0 of current ║
║ file. ║
║ 3. PutRec is called to write current record to disk. ║
║ ║
╚═══════════════════════════════════════════════════════════════════════╝
}
PROCEDURE GS_dBase_DB.UnDelete;
begin
DelFlag := false; {Set Delete flag to false}
CurRecord^[0] := GS_dBase_UnDltChr;
{Put ' ' in first byte of current record}
PutRec(RecNumber); {Write the current record to disk }
end;
begin
end.
